home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfaexprt.lzh / GFAXPERT.LIB / TIME.LST < prev   
Encoding:
File List  |  1986-10-19  |  14.7 KB  |  587 lines
  1. ' ****************
  2. ' *** TIME.LST ***
  3. ' ****************
  4. '
  5. DEFWRD "a-z"
  6. '
  7. > PROCEDURE set.date
  8.   ' *** input of new date (at current cursor-position)
  9.   LOCAL inputdate$
  10.   REPEAT
  11.     PRINT "date (dd.mm.yy) : ";
  12.     FORM INPUT 8,inputdate$
  13.   UNTIL LEN(inputdate$)=8
  14.   SETTIME TIME$,inputdate$
  15. RETURN
  16. ' **********
  17. '
  18. > PROCEDURE set.time
  19.   ' *** input of new time (at current cursor-position)
  20.   ' *** '.' is used as separator !
  21.   ' *** if user presses <Return> immediately, time will not be changed
  22.   LOCAL x$,inputtime$
  23.   REPEAT
  24.     PRINT "time (hh.mm.ss) : ";
  25.     FORM INPUT 8,x$
  26.   UNTIL LEN(x$)=8 OR x$=CHR$(13)
  27.   LET inputtime$=MID$(x$,1,2)+":"+MID$(x$,4,2)+":"+MID$(x$,7,2)
  28.   SETTIME inputtime$,DATE$
  29. RETURN
  30. ' **********
  31. '
  32. > PROCEDURE stopwatch
  33.   ' *** 1st call : start stopwatch
  34.   ' *** 2nd call : stop stopwatch
  35.   ' *** global :   STOP.SECONDS#   STOP.H   STOP.M   STOP.S   WATCH.ON!
  36.   LOCAL s#
  37.   IF watch.on!
  38.     stop.watch#=TIMER
  39.     stop.seconds#=(stop.watch#-start.watch#)/200
  40.     stop.h=stop.seconds#/3600
  41.     s#=stop.seconds#-stop.h*3600
  42.     stop.m=s#/60
  43.     stop.s=s#-stop.m*60
  44.     watch.on!=FALSE
  45.   ELSE
  46.     watch.on!=TRUE
  47.     start.watch#=TIMER
  48.   ENDIF
  49. RETURN
  50. ' ***
  51. > PROCEDURE print.stopwatch
  52.   ' *** print elapsed time at current cursor-position
  53.   IF stop.h>0
  54.     PRINT stop.h;" h ";stop.m;" m";
  55.   ELSE
  56.     IF stop.m>0
  57.       PRINT stop.m;" m ";stop.s;" s";
  58.     ELSE
  59.       IF stop.seconds#>=10
  60.         PRINT USING "##.# s",stop.seconds#;
  61.       ELSE
  62.         PRINT USING "#.## s",stop.seconds#;
  63.       ENDIF
  64.     ENDIF
  65.   ENDIF
  66. RETURN
  67. ' **********
  68. '
  69. > PROCEDURE day.of.week(day.date$,VAR day$)
  70.   ' *** return day of week, determined with Zeller's Congruence
  71.   LOCAL day,mp,month,year,m,h,w,week$,n
  72.   day=VAL(LEFT$(day.date$,2))
  73.   mp=INSTR(day.date$,".")
  74.   month=VAL(MID$(day.date$,mp+1,2))
  75.   year=VAL(RIGHT$(day.date$,4))
  76.   IF month<=2
  77.     m=10+month
  78.     year=year-1
  79.   ELSE
  80.     m=month-2
  81.   ENDIF
  82.   h=year/100
  83.   y=year-100*h
  84.   w=(TRUNC(2.6*m-0.2)+day+y+TRUNC(y/4)+TRUNC(h/4)-2*h) MOD 7
  85.   RESTORE weekdays
  86.   FOR n=0 TO w
  87.     READ day$
  88.   NEXT n
  89.   '
  90.   weekdays:
  91.   DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday
  92. RETURN
  93. ' **********
  94. '
  95. > PROCEDURE print.date(print.date$)
  96.   ' *** print date as : weekday day month year (e.g. Friday 8 January 1988)
  97.   ' *** uses Procedure Day.of.week
  98.   LOCAL day,year$,m$,mp,m,month$,n
  99.   @day.of.week(print.date$,print.day$)
  100.   day=VAL(LEFT$(print.date$,2))
  101.   year$=RIGHT$(print.date$,4)
  102.   mp=INSTR(print.date$,".")
  103.   m$=MID$(print.date$,mp+1,2)
  104.   m=VAL(m$)
  105.   RESTORE months
  106.   FOR n=1 TO m
  107.     READ month$
  108.   NEXT n
  109.   PRINT print.day$;" ";day;" ";month$;" ";year$;
  110.   '
  111.   months:
  112.   DATA January,February,March,April,May,June,July
  113.   DATA August,September,October,November,December
  114. RETURN
  115. ' **********
  116. '
  117. > PROCEDURE date.input(VAR datum$)
  118.   ' *** invoer datum
  119.   ' *** accepteert verschillende formaten, b.v. :
  120.   ' *** 1-6-'88   02-11-88   3.6.88   2/1/88   12 juni 1988   9 aug 88
  121.   ' *** jaartallen 0 - 99 invoeren als YYY (3 cijfers); YY wordt n.l. 19YY
  122.   '
  123.   LOCAL x,y,date.input$,ok!,day$,day,month.input$,month$
  124.   LOCAL n,month!,month,year$,year
  125.   x=CRSCOL
  126.   y=CRSLIN
  127.   ON ERROR GOSUB date.input.error
  128.   '
  129.   date.input:
  130.   ' *** invoer datum
  131.   ok!=TRUE
  132.   FORM INPUT 18,date.input$
  133.   ' *** dag
  134.   day.len=VAL?(date.input$)
  135.   IF day.len>2                         ! vanwege formaat 2.3.88
  136.     IF INSTR(date.input$,".")=2
  137.       day.len=1
  138.     ELSE
  139.       IF INSTR(date.input$,".")=3
  140.         day.len=2
  141.       ELSE
  142.         ok!=FALSE
  143.       ENDIF
  144.     ENDIF
  145.   ENDIF
  146.   day$=LEFT$(date.input$,day.len)
  147.   day=VAL(day$)
  148.   IF day>31 OR day<1
  149.     ok!=FALSE
  150.   ENDIF
  151.   ' *** maand
  152.   month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len+1))
  153.   month.len=VAL?(month.input$)
  154.   IF month.len=0                  ! maand als naam (of afkorting) ingevoerd
  155.     month$=LEFT$(month.input$,3)
  156.     month$=UPPER$(month$)
  157.     month.data:
  158.     DATA JAN,1,FEB,2,MAA,3,MRT,3,APR,4,MEI,5,JUN,6,JUL,7
  159.     DATA AUG,8,SEP,9,OKT,10,OCT,10,NOV,11,DEC,12
  160.     DIM date.input.month$(14),date.input.month(14)
  161.     RESTORE month.data
  162.     FOR n=1 TO 14
  163.       READ date.input.month$(n),date.input.month(n)
  164.     NEXT n
  165.     FOR n=1 TO 14
  166.       IF date.input.month$(n)=month$
  167.         month!=TRUE
  168.         month=date.input.month(n)
  169.       ENDIF
  170.     NEXT n
  171.     ERASE date.input.month$()
  172.     ERASE date.input.month()
  173.     IF NOT month!
  174.       ok!=FALSE
  175.     ENDIF
  176.   ELSE
  177.     month=VAL(month.input$)         ! maand als getal ingevoerd
  178.   ENDIF
  179.   IF month>12 OR month<1
  180.     ok!=FALSE
  181.   ENDIF
  182.   month$=STR$(month)
  183.   IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30
  184.     ok!=FALSE
  185.   ENDIF
  186.   IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31
  187.     ok!=FALSE
  188.   ENDIF
  189.   ' *** jaar
  190.   year$=RIGHT$(date.input$,4)
  191.   IF VAL?(year$)<>4 OR INSTR(year$,".")
  192.     year$=RIGHT$(date.input$,3)
  193.     IF VAL?(year$)<>3 OR INSTR(year$,".")
  194.       year$=RIGHT$(date.input$,2)
  195.       IF VAL?(year$)<>2 OR INSTR(year$,".")
  196.         ok!=FALSE
  197.       ENDIF
  198.       year$="19"+year$                ! jaar YY wordt 19YY
  199.     ENDIF
  200.   ENDIF
  201.   WHILE LEFT$(year$,1)="0"            ! nullen aan begin verwijderen
  202.     year$=RIGHT$(year$,LEN(year$)-1)
  203.   WEND
  204.   year=VAL(year$)
  205.   IF month=2                      ! schrikkeljaar-controle voor maand februari
  206.     IF day>28
  207.       IF (year MOD 400=0) AND day<>29
  208.         ok!=FALSE
  209.       ELSE
  210.         IF year MOD 100=0 AND (year MOD 400<>0)
  211.           ok!=FALSE
  212.         ELSE
  213.           IF (year MOD 4=0) AND day<>29
  214.             ok!=FALSE
  215.           ELSE
  216.             IF (year MOD 4<>0)
  217.               ok!=FALSE
  218.             ENDIF
  219.           ENDIF
  220.         ENDIF
  221.       ENDIF
  222.     ENDIF
  223.   ENDIF
  224.   ' *** datum
  225.   IF NOT ok!
  226.     PRINT bel$;
  227.     PRINT AT(x,y);STRING$(LEN(date.input$)," ");
  228.     PRINT AT(x,y);"FOUTIEF FORMAAT !!";
  229.     PAUSE 50
  230.     PRINT AT(x,y);STRING$(18," ");
  231.     PRINT AT(x,y);"";
  232.     GOTO date.input
  233.   ENDIF
  234.   datum$=day$+"."+month$+"."+year$
  235.   ON ERROR
  236. RETURN
  237. ' ***
  238. > PROCEDURE date.input.error
  239.   ' *** opvang onverwachte error
  240.   ok!=FALSE
  241.   ON ERROR GOSUB date.input.error
  242.   RESUME NEXT
  243. RETURN
  244. ' **********
  245. '
  246. > PROCEDURE start.date.input
  247.   ' *** invoer datum bij opstarten
  248.   ' *** accepteert verschillende formaten, b.v. :
  249.   ' *** 1-6-'88   02-11-88   3.6.88   2/1/88   12 juni 1988   9 aug 88
  250.   LOCAL x,y,date.input$,ok!,day$,day,month.input$,month$,n,month!,month,year$,year
  251.   LOCAL new.date$
  252.   PRINT " datum (dag-maand-jaar) : ";
  253.   x=CRSCOL
  254.   y=CRSLIN
  255.   ON ERROR GOSUB start.date.input.error
  256.   '
  257.   start.date.input:
  258.   ' *** invoer datum
  259.   ok!=TRUE
  260.   FORM INPUT 18,date.input$
  261.   ' *** dag
  262.   day.len=VAL?(date.input$)
  263.   IF day.len>2                         ! vanwege formaat 2.3.88
  264.     IF INSTR(date.input$,".")=2
  265.       day.len=1
  266.     ELSE
  267.       IF INSTR(date.input$,".")=3
  268.         day.len=2
  269.       ELSE
  270.         ok!=FALSE
  271.       ENDIF
  272.     ENDIF
  273.   ENDIF
  274.   day$=LEFT$(date.input$,day.len)
  275.   day=VAL(day$)
  276.   IF day>31 OR day<1
  277.     ok!=FALSE
  278.   ENDIF
  279.   ' *** maand
  280.   month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len+1))
  281.   month.len=VAL?(month.input$)
  282.   IF month.len=0                  ! maand als naam (of afkorting) ingevoerd
  283.     month$=LEFT$(month.input$,3)
  284.     month$=UPPER$(month$)
  285.     start.month.data:
  286.     DATA JAN,1,FEB,2,MAA,3,MRT,3,APR,4,MEI,5,JUN,6,JUL,7
  287.     DATA AUG,8,SEP,9,OKT,10,OCT,10,NOV,11,DEC,12
  288.     DIM date.input.month$(14),date.input.month(14)
  289.     RESTORE start.month.data
  290.     FOR n=1 TO 14
  291.       READ date.input.month$(n),date.input.month(n)
  292.     NEXT n
  293.     FOR n=1 TO 14
  294.       IF date.input.month$(n)=month$
  295.         month!=TRUE
  296.         month=date.input.month(n)
  297.       ENDIF
  298.     NEXT n
  299.     ERASE date.input.month$()
  300.     ERASE date.input.month()
  301.     IF NOT month!
  302.       ok!=FALSE
  303.     ENDIF
  304.   ELSE
  305.     month=VAL(month.input$)         ! maand als getal ingevoerd
  306.   ENDIF
  307.   IF month>12 OR month<1
  308.     ok!=FALSE
  309.   ENDIF
  310.   month$=STR$(month)
  311.   IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30
  312.     ok!=FALSE
  313.   ENDIF
  314.   IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31
  315.     ok!=FALSE
  316.   ENDIF
  317.   ' *** jaar
  318.   year$=RIGHT$(date.input$,2)
  319.   IF VAL?(year$)<>2 OR INSTR(year$,".") OR VAL(year$)<88
  320.     ok!=FALSE
  321.   ENDIF
  322.   year=VAL(year$)
  323.   IF month=2                      ! schrikkeljaar-controle voor maand februari
  324.     IF day>28
  325.       IF (year MOD 400=0) AND day<>29
  326.         ok!=FALSE
  327.       ELSE
  328.         IF year MOD 100=0 AND (year MOD 400<>0)
  329.           ok!=FALSE
  330.         ELSE
  331.           IF (year MOD 4=0) AND day<>29
  332.             ok!=FALSE
  333.           ELSE
  334.             IF (year MOD 4<>0)
  335.               ok!=FALSE
  336.             ENDIF
  337.           ENDIF
  338.         ENDIF
  339.       ENDIF
  340.     ENDIF
  341.   ENDIF
  342.   ' *** datum
  343.   IF NOT ok!
  344.     PRINT bel$;
  345.     PRINT AT(x,y);STRING$(LEN(date.input$)," ");
  346.     PRINT AT(x,y);"FOUTIEF FORMAAT !!";
  347.     PAUSE 50
  348.     PRINT AT(x,y);STRING$(18," ");
  349.     PRINT AT(x,y);"";
  350.     GOTO start.date.input
  351.   ENDIF
  352.   LET new.date$=day$+"."+month$+"."+year$
  353.   SETTIME TIME$,new.date$
  354.   ON ERROR
  355. RETURN
  356. ' ***
  357. > PROCEDURE start.date.input.error
  358.   ' *** opvang onverwachte error
  359.   ok!=FALSE
  360.   ON ERROR GOSUB start.date.input.error
  361.   RESUME NEXT
  362. RETURN
  363. ' **********
  364. '
  365. > PROCEDURE time.input(VAR tijd$)
  366.   ' *** invoer tijd (seconden eventueel weglaten)
  367.   ' *** accepteert verschillende formaten, b.v. :
  368.   ' *** 12.40.10    1:30:25    20.45
  369.   '
  370.   LOCAL x,y,ok!,time.input$,hour.len,hour$,minute.input$,minute.len
  371.   LOCAL minute$,second$,second.input$,second.len
  372.   x=CRSCOL
  373.   y=CRSLIN
  374.   ON ERROR GOSUB time.input.error
  375.   '
  376.   time.input:
  377.   ' *** invoer tijd
  378.   ok!=TRUE
  379.   FORM INPUT 10,time.input$
  380.   ' *** uren
  381.   hour.len=VAL?(time.input$)
  382.   IF hour.len>2                            ! vanwege formaat 12.30.00
  383.     IF INSTR(time.input$,".")=2
  384.       hour.len=1
  385.     ELSE
  386.       IF INSTR(time.input$,".")=3
  387.         hour.len=2
  388.       ELSE
  389.         ok!=FALSE
  390.       ENDIF
  391.     ENDIF
  392.   ENDIF
  393.   hour$=LEFT$(time.input$,hour.len)
  394.   IF VAL(hour$)>23
  395.     ok!=FALSE
  396.   ENDIF
  397.   ' *** minuten
  398.   LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len+1))
  399.   LET minute.len=VAL?(minute.input$)
  400.   IF minute.len>2                            ! vanwege formaat 12.30.00
  401.     IF INSTR(minute.input$,".")=2
  402.       LET minute.len=1
  403.     ELSE
  404.       IF INSTR(minute.input$,".")=3
  405.         LET minute.len=2
  406.       ELSE
  407.         ok!=FALSE
  408.       ENDIF
  409.     ENDIF
  410.   ENDIF
  411.   LET minute$=LEFT$(minute.input$,minute.len)
  412.   IF VAL(minute$)>59
  413.     ok!=FALSE
  414.   ENDIF
  415.   ' *** seconden
  416.   IF minute.len>=LEN(minute.input$)-1
  417.     second$="0"
  418.   ELSE
  419.     second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len+1))
  420.     second$=LEFT$(second.input$,2)
  421.     IF VAL(second$)>59
  422.       ok!=FALSE
  423.     ENDIF
  424.   ENDIF
  425.   ' *** tijd
  426.   IF NOT ok!
  427.     PRINT bel$;
  428.     PRINT AT(x,y);STRING$(LEN(time.input$)," ");
  429.     PRINT AT(x,y);"ONJUIST !!";
  430.     PAUSE 50
  431.     PRINT AT(x,y);STRING$(10," ");
  432.     PRINT AT(x,y);"";
  433.     GOTO time.input
  434.   ENDIF
  435.   tijd$=hour$+":"+minute$+":"+second$
  436.   ON ERROR
  437. RETURN
  438. ' ***
  439. > PROCEDURE time.input.error
  440.   ' *** opvang onverwachte error
  441.   ok!=FALSE
  442.   ON ERROR GOSUB time.input.error
  443.   RESUME NEXT
  444. RETURN
  445. ' **********
  446. '
  447. > PROCEDURE start.time.input
  448.   ' *** invoer tijd bij opstarten (seconden eventueel weglaten)
  449.   ' *** direct <RETURN> = 00:00:00
  450.   ' *** accepteert verschillende formaten, b.v. :
  451.   ' *** 12.40.10    1:30:25    20.45
  452.   '
  453.   LOCAL x,y,ok!,time.input$,hour.len,hour$,minute.input$,minute.len
  454.   LOCAL minute$,second$,second.input$,second.len,new.time$
  455.   PRINT " tijd (uur.min[.sec]) : ";
  456.   x=CRSCOL
  457.   y=CRSLIN
  458.   ON ERROR GOSUB start.time.input.error
  459.   '
  460.   start.time.input:
  461.   ' *** invoer tijd
  462.   ok!=TRUE
  463.   FORM INPUT 10,time.input$
  464.   IF time.input$=""
  465.     LET new.time$="00:00:00"
  466.     GOTO start.time.exit
  467.   ENDIF
  468.   ' *** uren
  469.   hour.len=VAL?(time.input$)
  470.   IF hour.len>2                            ! vanwege formaat 12.30.00
  471.     IF INSTR(time.input$,".")=2
  472.       hour.len=1
  473.     ELSE
  474.       IF INSTR(time.input$,".")=3
  475.         hour.len=2
  476.       ELSE
  477.         ok!=FALSE
  478.       ENDIF
  479.     ENDIF
  480.   ENDIF
  481.   hour$=LEFT$(time.input$,hour.len)
  482.   IF VAL(hour$)>23
  483.     ok!=FALSE
  484.   ENDIF
  485.   ' *** minuten
  486.   LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len+1))
  487.   LET minute.len=VAL?(minute.input$)
  488.   IF minute.len>2                            ! vanwege formaat 12.30.00
  489.     IF INSTR(minute.input$,".")=2
  490.       LET minute.len=1
  491.     ELSE
  492.       IF INSTR(minute.input$,".")=3
  493.         LET minute.len=2
  494.       ELSE
  495.         ok!=FALSE
  496.       ENDIF
  497.     ENDIF
  498.   ENDIF
  499.   LET minute$=LEFT$(minute.input$,minute.len)
  500.   IF VAL(minute$)>59
  501.     ok!=FALSE
  502.   ENDIF
  503.   ' *** seconden
  504.   IF minute.len>=LEN(minute.input$)-1
  505.     second$="0"
  506.   ELSE
  507.     second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len+1))
  508.     second$=LEFT$(second.input$,2)
  509.     IF VAL(second$)>59
  510.       ok!=FALSE
  511.     ENDIF
  512.   ENDIF
  513.   ' *** tijd
  514.   IF NOT ok!
  515.     PRINT bel$;
  516.     PRINT AT(x,y);STRING$(LEN(time.input$)," ");
  517.     PRINT AT(x,y);"ONJUIST !!";
  518.     PAUSE 50
  519.     PRINT AT(x,y);STRING$(10," ");
  520.     PRINT AT(x,y);"";
  521.     GOTO start.time.input
  522.   ENDIF
  523.   LET new.time$=hour$+":"+minute$+":"+second$
  524.   start.time.exit:
  525.   SETTIME new.time$,DATE$
  526.   ON ERROR
  527. RETURN
  528. ' ***
  529. > PROCEDURE start.time.input.error
  530.   ' *** opvang onverwachte error
  531.   ok!=FALSE
  532.   ON ERROR GOSUB start.time.input.error
  533.   RESUME NEXT
  534. RETURN
  535. ' **********
  536. '
  537. > PROCEDURE initio.milli.timer
  538.   ' *** speciale timer; kleinste gemeten tijdeenheid = timer.step#
  539.   ' *** afhankelijk van o.a. accessories varieert deze tijdeenheid
  540.   ' *** de maximaal haalbare nauwkeurigheid is minder dan 0.2 milliseconden
  541.   ' *** out : TIMER.STEP#
  542.   LOCAL t1#,t2#,i,k%
  543.   REPEAT
  544.   UNTIL INKEY$=""
  545.   t1#=TIMER
  546.   FOR i=1 TO 20000
  547.     KEYLOOK k%
  548.     EXIT IF k%<>0
  549.   NEXT i
  550.   t2#=TIMER
  551.   timer.step#=(t2#-t1#)/4000000              ! tijdeenheid in seconden
  552. RETURN
  553. ' ***
  554. > PROCEDURE milli.timer
  555.   ' *** eerst Procedure initio.milli.timer aanroepen
  556.   ' *** reactietijd voor indrukken van een toets in milliseconden
  557.   ' *** out : MILLI.SEC#
  558.   LOCAL i,k%
  559.   FOR i=1 TO 20000
  560.     KEYLOOK k%
  561.     EXIT IF k%<>0
  562.   NEXT i
  563.   milli.sec#=ROUND(i*timer.step#*1000,1)    ! 1 cijfer achter komma
  564. RETURN
  565. ' **********
  566. '
  567. > PROCEDURE time
  568.   ' *** PRINT time at right upper corner (change position if necessary)
  569.   ' *** activate with : EVERY 200 GOSUB time
  570.   ' *** TIME$ is updated every 2 (!) seconds, therefore little trick necessary
  571.   ' *** cursor-position saved and restored
  572.   ' *** uses Standard Global scrn.col.max
  573.   ' *** global :  TIMER$
  574.   LOCAL t$
  575.   t$=TIME$
  576.   IF t$=timer$
  577.     MID$(timer$,8)=SUCC(RIGHT$(timer$))
  578.   ELSE
  579.     timer$=t$
  580.   ENDIF
  581.   PRINT "j";
  582.   PRINT AT(SUB(scrn.col.max,7),1);timer$;
  583.   PRINT "k";
  584. RETURN
  585. ' **********
  586. '
  587.